home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / purdue / prob12.fcm < prev    next >
Text File  |  1993-06-26  |  2KB  |  77 lines
  1.       PROGRAM PROB12
  2. C
  3. C     PROBLEM 12
  4. C
  5. C  REFERENCE:  PROBLEMS TO TEST PARALLEL AND VECTOR LANGUAGES
  6. C              CSD-TR 516, COMPUTER SCIENCE, PURDUE UNIVERSITY
  7. C              JOHN R. RICE, MAY 1, 1985
  8. C
  9. C              REVISED BY JOHN R. RICE AND J. JING, OCT. 1, 1990
  10. C
  11. C
  12. C      *************************************************
  13. C      *      Adapted for FORTRAN D benchmarking       *
  14. C      *    by  T. HAUPT  (haupt@sccs.npac.syr.edu)    *
  15. C      *                                               *
  16. C      *    Northeast Parallel Architectures Center    *
  17. C      *   at Syracuse University, Syracuse, NY, USA   *
  18. C      *************************************************
  19. C
  20. C
  21. C       VERSION SIMD/CM2-1.00
  22. C       ==================================================
  23. C
  24.       INCLUDE '/usr/include/cm/paris-configuration-fort.h'
  25.       INTEGER KASES,NK,MK
  26.       PARAMETER (KASES=4)
  27.       INTEGER N(KASES),M(KASES)
  28. cmf$  layout N(:serial)
  29. cmf$  layout M(:serial)
  30.       DATA N / 127,127,511,1023 /
  31.       DATA M / 127,511,511,511 /
  32.       REAL TP1,TP2
  33.  
  34.       DO 50 K = 1, KASES
  35.  
  36.       CALL CM_TIMER_CLEAR(0)
  37.       CALL CM_TIMER_START(0)
  38.       DO MANY=1,150
  39.       NK=N(K)
  40.       MK=M(K)
  41.       CALL DOIT(NK,MK,TP1,TP2)
  42.       ENDDO
  43.       CALL CM_TIMER_STOP(0)
  44.  
  45.       PRINT 80,NK,MK
  46.    80 FORMAT ('PROBLEM 12 WITH N,M =',I6,2X,I6)
  47.       PRINT*,'GIVES CORNER PRODUCTS =', TP1,TP2
  48.  
  49.       CALL CM_TIMER_PRINT(0)
  50.  
  51.    50 CONTINUE
  52.  
  53. c     STOP
  54.       END
  55.  
  56.  
  57.       SUBROUTINE DOIT(NK,MK,TP1,TP2)
  58.       INTEGER NK,MK
  59.       REAL TP1,TP2
  60.       REAL, ARRAY(NK+1,MK+1)    :: ABIG
  61.       REAL ACORN
  62.  
  63.  
  64.       ACORN = .5
  65.       ABIG(1:NK,1:MK)=SPREAD([1:NK],2,MK)+SPREAD([1:MK],1,NK)
  66.       ABIG(1:NK,MK+1:MK+1)=spread (1.0-[1:NK], 2, 1)
  67.       ABIG(NK+1,1:MK)=1.0+[1:MK]
  68.  
  69.       ABIG(NK+1,MK+1)=ACORN
  70.  
  71.  
  72.       TP1 = ABIG(1,1)*ABIG(1,MK+1)*ABIG(NK+1,MK)*ABIG(NK+1,MK+1)
  73.       TP2 = ABIG(NK,MK)*ABIG(NK,MK+1)*ABIG(NK+1,MK)*ABIG(NK+1,MK+1)
  74.  
  75. c     RETURN
  76.       END
  77.